Apple Reference & Presen…rary 6 (Reseller Edition)/Apple Ref. & Pres. Lib.v6.0.toast/mac/2-Graphics/Apple Graphics Source/Apple Graphics Source 3.0/stack_-1.xml

Extensible Markup Language | 1990-08-07 | 25KB | 16 lines

<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE stack PUBLIC "-//Apple, Inc.//DTD stack V 2.0//EN" "" >
<stack>
    <name>in.0</name>
    <id>-1</id>
    <cardCount>621</cardCount>
    <cardID>3356</cardID>
    <listID>2406</listID>
    <cantModify><true /></cantModify>
    <cantDelete><false /></cantDelete>
    <cantAbort><false /></cantAbort>
    <cardSize>
        <width>512</width>
        <height>342</height>
    </cardSize>
    <script>--•• SYSTEM MESSAGESon openStackglobal firstTimeAGS,artManagement,findParams,lastFindTermsif the version < 1.2 thendialogIt "Sorry. You need HyperCard version 1.2 or greater." ¬&& "You are using version" & the version & "."end ifif firstTimeAGS is empty then-- This is the first time you have opened the stack in this-- HyperCard session.put false into artManagementend ifshow menubarput empty into findParamsput empty into lastFindTermspass openStackend openStackon closeStackglobal artManagement,taggedListsaveChanges true,taggedList,trueif artManagement thenset cursor to busylock screenset lockMessages to trueset lockRecent to truego bg "the collection"send "adminElements false" to this bgend ifpass closeStackend closeStackon arrowKey whichKeyset textArrows to not (selectedChunk() is empty)pass arrowkeyend arrowKeyon domenu menu                       --// Added by Medior, Inc. 8/8/90global RPStackNameif menu is in "Home,Quit HyperCard" and RPStackName is not empty thenset cursor to watchput RPStackName into shortnamerepeat until offset(":",shortname) = 0delete char 1 to offset(":",shortname) of shortnameend repeatdelete last char of shortnameanswer "This will return to "&shortname&"." with "Cancel" or "OK"if it is "Cancel" then exit domenuset cursor to watchlock screengo RPStackNameunlock screen with dissolveexit domenuelse pass doMenuend domenu--•• MESSAGE HANDLERSon goStack whichStackif the hilite of the target then exit goStackset lockMessages to trueset lockRecent to truelock screengo stack "Apple Graphics - " & whichStackanswer "Check the stack name to see if its changed."go bg "the collection"unlock screen with visual effect dissolveopenBackgroundopenCardend goStackon adminglobal artManagementput true into artManagementsend "adminElements true" to this bgif the cantModify of this stack thendialogIt "To use the developer buttons in the background" && ¬"The Collection, move this stack to an unlocked volume."end ifend adminon closeAdminglobal artManagementput false into artManagementsend "adminElements false" to this bgend closeAdminon selectLine whichLine,whichFld--whichLine is a wholeNumber and whichFld is the short name of a fld.if whichLine = empty OR whichFld = empty then exit selectLineput line whichLine of fld whichFld into theTextif theText is not empty thenput (number of chars of line 1 to whichLine of fld whichFld) ¬+ 1 into endCharselect char (endChar - length (theText)) to endChar of fld whichFldwait 5end ifend selectLineon stopBtnStatus booleanset visible of fld "status" to booleanend stopBtnStatuson showProgress whichText, whichPercentput whichText && "(" & whichPercent & "% Complete" & ")"end showProgresson hideProgressput emptyhide msgend hideProgresson toggleLockScreenunlock screenlock screenunlock screenend toggleLockScreenon showListNameglobal activeListNameif the short name of this bg is not "the collection" thengo bg "the collection"end ifset the name of bg btn id 353 to "List Name:" && activeListNameend showListNameon goListStack thisCard--Takes you to the list stack, or returns "no" if this is unsuccesful.--thisCard, the name of the card in the list stack--you want to go to. is optional.global listStacklock screenset lockMessages to trueset lockRecent to truego stack listStackif the short name of this stack <> listStack then exit to hypercardif cantModify of this stack thendialogIt "The stack" && quote & listStack & quote && "is locked." ¬&& "You can't save changes to your lists until you unlock" && ¬"the stack" && quote & listStack & quote & "."return "no"end ifif thisCard is not empty then go cd thisCardif the result is not empty then--this card wasn't founddialogIt "The card" && thisCard && "was not found in" && ¬"the stack" && listStack && "."return "no"end ifend goListStack--LIST scriptson deleteListEntries whichFieldset cursor to arrowlock screensend "deleteEntryVisible true" to this cdput the rect of the name of whichField into listRectput listRect into validAreasubtract 17 from item 3 of validArea--17 is the width of the scroll barunlock screen with barn door openrepeatwait while the mouse is up--the user clicked the mouseput the clickLoc into userLocif userLoc is within the rect of (the name of whichField) AND ¬userLoc is not within validArea then--user clicked on the scroll barnext repeatend ifif userLoc is NOT within validArea OR ¬(the name of whichField) = empty then exit repeatput clickLine(the name of whichField) into whatLineif line whatLine of (the value of whichField) = empty thenexit repeatend ifif isEvenNumber(whatLine) then subtract 1 from whatLinerepeat 2 timessend "selectLine whatLine, the short name of whichField" ¬to this cddo "delete line whatLine of" && the name of whichFieldend repeatreNumberSequence whatLine,whichFieldset cursor to arrowend repeatsend "deleteEntryVisible false" to this cdend deleteListEntrieson reNumberSequence N,whichField--N is the line number of the first line that needs a new entry numberglobal entryPrefix, entrySuffixput the value of whichField into thisFieldrepeat until line N of thisField = emptyset cursor to watchdelete char 1 to the number of chars in entryPrefix ¬of line N of thisFieldput (N / 2 + .5) into newNumberput beginEntryLine(newNumber) into beginLineput beginLine & newNumber & entrySuffix ¬before line N of thisFielddo "put thisField into" && the name of whichFieldadd 2 to Nend repeatend reNumberSequenceon findEntry whichLine,findThis,whichFieldglobal listScroll,entryPrefixif findThis is empty then exit findEntryif (whichLine/2) = trunc(whichLine/2) then-- user selected a file nameput line whichLine of the value of whichField into uniqueNumberelse-- user selected a nameput line (whichLine+1) of the value of whichField into uniqueNumberend if-- get rid of extra charactersdelete char 1 to (the number of chars in entryPrefix) ¬of uniqueNumberif the short name of this bg is not "the collection" thengo bg "the collection"end iffind whole uniqueNumber in fld "file name field"if the foundText is empty thendialogIt "In this stack, there isn’t a graphic with the file name" ¬&& quote & uniqueNumber & quote & "."exit findEntryend ifset scroll of fld "list" to listScrollunlock screen with visual effect wipe leftend findEntryon saveChanges dialogNeeded,toBeSaved,savingOpenListglobal activeListName,changesToList,taggedList--dialogNeeded = true if a dialog is needed asking the user--if they want to save changes.--savingOpenList = false if you are saving a list that is not--the active list (as you can do on the Focus card).-- Return true if the save was completed and succesfully.-- Otherwise, it return false.put the long name of this cd into afterSaveGoHereif savingOpenList thenif changesToList is not true then return false--the exit was made because a save was unnecessary.if dialogNeeded then-- The user needs to be asked if they want to save changes.dialogIt "Save changes to the list " ¬& quote & activeListName & quote & "?", "No,Yes"if the result is "No" then-- The user doesn't want to save the current list.put "Untitled" into activeListNameput false into changesToListput empty into taggedListexit saveChangesend ifend ifend ifif activeListName is "untitled" OR activeListName is empty then--Get a name for the listcheckListName "Save the list as (15 letters or less):"if the result is not empty then return false--you are at the new list card.end ifgoListStack activeListNameif the result is "no" thengo afterSaveGoHerereturn falseend ifset cursor to busyput toBeSaved into fld "tagged list"go afterSaveGoHereset cursor to busyif savingOpenList thenput false into changesToListshowListNameend ifreturn trueend saveChangeson checkListName prompt,default-- If list entered is invalid, return a non-empty value.global activeListNameif default = "untitled" then put empty into defaultask prompt with defaultput it into whichNameif whichName = empty then return "1"else if not validListName(whichName) thencheckListName prompt,defaultexit checkListNameend if-- You're in the list stack.put whichName into activeListNamego last cd of this bgdoMenu "new card"set the name of this cd to activeListNameend checkListNameon dialogIt whichText, whichButtons, whichFont, whichIconif whichButtons is empty then put "OK" into whichButtonsif whichIcon is empty then put "0" into whichIconif whichFont is empty then put "chicago" into whichFontget dialog(whichText,whichButtons,whichIcon,whichFont,plain,12)return itend dialogIt--• THESE SCRIPTS USE THE POINTERS TO FIND SPECIFIC CARDS.on findAGS dialogPhrase,indexField,pointerField,writeField,goForwardglobal findParams,lastFindTermsif the number of lines in lastFindTerms > 1 thenput getCardIdIntersection(lastFindTerms,pointerField,writeField) ¬into validFileNameselseput getValidFileNames(lastFindTerms,pointerField,writeField) ¬into validFileNamesend ifput binaryInsert(bg fld "file name field",validFileNames) ¬into thisItem-- thisItem is the item number in validFileNames of the NEXT valid-- file name in the stack.put allFoundPrefix(lastFindTerms,dialogPhrase) into allFoundput noneFoundPrefix(lastFindTerms,dialogPhrase) into noneFoundif thisItem = 0 thendialogIt noneFoundexit findAGSend ifif not goForward thenput advanceItem(thisItem,goForward,validFileNames) into thisItemend iflock screenrepeat with N = (the number of items in validFileNames) down to 1if the mouseClick then exit repeatput getCardId(item thisItem of validFileNames) into thisCardIdif thisCardId is empty then exit repeatgo cd id thisCardIdif the result is not empty then next repeatif the number of lines in lastFindTerms = 1 thenput getLine(lastFindTerms,bg fld indexField) into thisLineif thisLine is empty then next repeatend if-- There is an exact match.updateStatus NstopBtnStatus trueif goForward then unlock screen with visual effect wipe leftelse unlock screen with visual effect wipe rightif the number of lines in lastFindTerms = 1 thenselectLine thisLine,indexFieldend ifif N <> the number of items in validFileNames then-- This is not the first time throughif shallWeStop() then exit repeatend iflock screenput empty into fld "Status"put advanceItem(thisItem,goForward,validFileNames) into thisItemif N = 1 then-- You've gone to all of the appropriate cards, so stop.wait 30stopBtnStatus falseunlock screenwait 40if not the mouseClick then dialogIt allFoundend ifend repeatput the params into findParamsstopBtnStatus falseput empty into bg fld "status"end findAGSon updateStatus cardsLeftif cardsLeft = 1 then put "occurrence" into phraseelse put "occurrences" into phraseput cardsLeft && phrase && "left. Click and Hold to Stop." ¬into fld "status"end updateStatus--• THESE SCRIPTS HANDLE THE POINTERS.on buildPointers indexField,writeField,pointerFieldput readIndex(writeField) into thisIndexput the number of lines in thisIndex into numberOfEntriesset cursor to watchlock screenset lockMessages to trueput "Building pointers for" && writeField into statusrepeat with N = 1 to numberOfEntriesshowProgress status,round(N/(numberOfEntries)*100)put line N of thisIndex into whichTextif whichText = empty OR whichText = space then next repeatgo cd 1 of bg "the collection"put empty into entriesput empty into firstCardput empty into currentCardrepeatfind whole whichText in fld indexFieldif the foundChunk is empty then--The text wasn't found in the specified field.exit repeatend ifput word 2 of the foundLine into thisLineif whichText <> line thisLine of fld indexField then--There was a find, but not an exact match, so look again.next repeatend ifif firstCard = empty thenput the short id of this cd into firstCardelse put the short id of this cd into currentCardif firstCard = currentCard then--you've been to all of the valid cards.exit repeatend if--If it got this far, then there was an exact match.put bg fld "file name field" & "," after entriesend repeatput the number of chars in whichText into fldNumberput last char of fldNumber into fldNumberif last char of entries is "," then delete last char of entrieswritePointer entries,N,pointerField && fldNumberend repeathideProgressend buildPointerson writePointer newPointer,lineNumber,fldNameput newPointer into line lineNumber of cd fld fldName ¬of cd "Index storage"end writePointer--•• END AGS ONLY--•• FUNCTIONSfunction diskSpaceAvailable-- Return true if the disk space available is greater than the-- limit given. Otherwise, return false.if the diskSpace > 5000 then return trueput the long name of this stack into stackNamedelete char 1 to 7 of stackNamedelete last char of stackNameput volumeName(stackName) into diskNameput round(the diskSpace / 1000) into spaceAvailabledialogIt "There is" && spaceAvailable & "K of disk space" && ¬"available on" && quote & diskName & quote & ". Since this may" && ¬"not be enough disk space to continue, the current task has been" && ¬"stopped. You should move this stack to a disk with more" && ¬"space available before continuing this task."return falseend diskSpaceAvailablefunction isWithin thisText, container-- Return true of thisText is a complete line in the given container.if line 1 of container = thisText ¬OR container contains return & thisText & return ¬OR thisText = last line of container then return truereturn falseend isWithinfunction clickLine whichField-- Return the number of the line clicked.-- First, determine how many lines are hidden aboveif the style of whichField is "scrolling" thenput the scroll of whichField into theScrollelse put 0 into theScrollput (theScroll / textHeight of whichField) into linesAbove-- add that number to the relative position clickedreturn round(linesAbove + lineClicked(whichField))end clickLinefunction lineClicked whichFieldreturn ((the mouseV - item 2 of the rect of whichField - 4) ¬div the textheight of whichField) + 1end lineClickedfunction beginEntryLine entryNumberif entryNumber < 10 then return space & spaceif entryNumber < 100 then return spaceif entryNumber < 1000 then return emptyend beginEntryLinefunction isEvenNumber whatString--returns true if the given string is an even number.if not positiveWholeNumber(whatString) then return falseif whatString mod 2 = 0 then return truereturn falseend isEvenNumberfunction linesVisible whichFld--returns the number of lines that are visible in a field.return round(height of whichFld/the textHeight of whichFld)end linesVisiblefunction readIndex writeFieldreturn cd fld writeField of cd "Index storage"end readIndexfunction getLine whichText,container--Where whichText is any text string.--Returns the line number of the given text in the given container.--Returns empty if an entire line in the container does not equal--whichText.--Note that OFFSET won't work because you're looking for--an entire line, not just a subset.if whichText = line 1 of container then return 1put offset(return & whichText & return,container) into theCharsif theChars <> 0 thenreturn (the number of lines in char 1 to theChars of container) + 1end ifif whichText = last line of container thenreturn (the number of lines in container)end ifreturn emptyend getLinefunction listDialog thelist,delimit,text,selectMode,theButtons,dlogNoglobal ListSelectExit--ListSelectExit is the name of the button the user clicked to leave--the dialog box.if delimit is 13 then put return into delimitget ListSelect(selectMode,theList,text,theButtons,delimit,dlogNo)return itend listDialogfunction sortContainer whichContainer--returns the given container sorted alphabetically.put alphaSort(whichContainer) into itreturn itend sortContainerfunction substitute originalChar, newChar, whichContainer--returns the given container with the given existing character--substituted in all cases for the given new character.repeatput offset(originalChar,whichContainer) into whichCharif whichChar = 0 then exit repeatput newChar into char whichChar of whichContainerend repeatreturn whichContainerend substitutefunction validListName whichNameif whichName is empty then return falseif whichName is "Untitled" thenanswer "List can't be named Untitled."return falseend ifif whichName is "id" thenanswer "Lists can't be named ID."return falseend ifif the length of whichName > 15 thenanswer "List names cannot have more than 15 letters."return falseend ifif nonNegativeNumber(whichName) thendialogIt "List names must contain at least one letter." && ¬"The list name" && quote & whichName & quote && "is invalid."return falseend ifgoListStackif the result is "no" thenpop cdexit to hypercardend ifgo bg "lists"repeat with i = 1 to (the number of cds in this bg)if the short name of this cd = whichName thendialogIt "There is already a list named" &&quote& ¬whichName &quote& ". Please use a different name."return falseend ifgo next cd of this bgend repeatreturn trueend validListNamefunction positiveWholeNumber whatString-- If whatString is a positive whole number, returns true.-- Otherwise, returns false.if not containsANumber(whatString) then return falserepeat with i = 1 to the length of whatStringif "1234567890" contains char i of whatString then next repeatelse return falseend repeat-- The final testif whatString > 0 then return trueelse return falseend positiveWholeNumberfunction nonNegativeNumber whatString--returns true if the given string is a non-negative number.if containsANumber(whatString) = false then return falserepeat with i = 1 to the length of whatStringif ".1234567890" contains char i of whatString then next repeat else-- if it makes it here, there is an invalid character,-- so exit now.return falseend ifend repeatreturn trueend nonNegativeNumberfunction containsANumber whatString--returns true if at least one of the characters in the--string is a number. Otherwise, returns falserepeat with i = 1 to the length of whatStringif "1234567890" contains char i of whatString then--there is at least one number, so go to the next test.exit repeatelse if i = the length of whatString then--you've gone through all characters & there aren't any numbers.return falseend ifend repeatreturn trueend containsANumberfunction getShortName longName-- Given the path to a file, return the name of the file.repeatif longName contains ":" thenput offset (":",longName) into thisChardelete char 1 to thisChar of longNameelse exit repeatend repeatreturn longNameend getShortNamefunction getPath longName-- Given the full path to a file, return-- the path to the file minus the name of the file.repeatif last char of longName <> ":" then delete last char of longNameelse exit repeatend repeatreturn longNameend getPathfunction volumeName pathName-- Given the full path to a file, return-- the name of the volume (i.e., the disk name, or top directory).put offset(":",pathName) into theCharsreturn char 1 to (theChars - 1) of pathNameend volumeName--•• FUNCTIONS (AGS ONLY)function allFoundPrefix whichText,dialogPhraseif the number of lines in whichText = 1 thenreturn "You’ve seen all of the graphics" && dialogPhrase ¬&& quote & whichText & quote & "."elsereturn "You've seen all of the graphics with all of the selected items."end ifend allFoundPrefixfunction noneFoundPrefix whichText,dialogPhraseif the number of lines in whichText = 1 thenreturn "There aren’t any graphics" && dialogPhrase ¬&& quote & whichText & quote & "."elsereturn "There aren’t any graphics that have all of the selected items."end ifend noneFoundPrefixfunction shallWeStop-- Pause at each card for a given amount of time.global ticksToWaitput (the ticks + ticksToWait) into stopTicksrepeat until stopTicks < (the ticks)if the mouse is down then return trueend repeatreturn falseend shallWeStopfunction advanceItem thisItem,goForward,validFileNamesput thisItem into testThisif goForward thenadd 1 to thisItemif thisItem > the number of items in validFileNames thenput 1 into thisItemend ifelsesubtract 1 from thisItemif thisItem = 0 thenput the number of items in validFileNames into thisItemend ifend ifreturn thisItemend advanceItemfunction getCardIdIntersection source,pointerField,writeField-- Return the card ids of all cards that meet the criteria.-- Source is a return-delimited list that determines the criteria.put getLeastItems(source,pointerField,writeField) into whichLineif whichLine is empty then return whichLineput line whichLine of source into occursLeast-- occursLeast is the text that occurs the least times in the stack.put getFileNames(occursLeast,source,writeField,pointerField) ¬into cardIdsreturn cardIdsend getCardIdIntersectionfunction getLeastItems object,pointerField,writeField-- Return the line number of the object that has the fewest-- occurrences in the stack.-- Object is a return-delimited list of terms (such as keywords, etc.)put empty into lowestput empty into leastItemsrepeat with N = 1 to the number of lines in objectset cursor to busyput line N of object into whichTextget numberOfOccurrences(whichText,pointerField,writeField)if lowest = empty OR it < lowest thenput it into lowestput N into leastItemsend ifend repeatreturn leastItemsend getLeastItemsfunction getFileNames whichText,source,writeField,pointerField-- Given a text string, its index, and pointer field that-- has the least occurrences in the stack, return a formatted list of-- descriptions and file names that meet the criteria.put getValidFileNames(whichText,pointerField,writeField) into subsetrepeat with N = 1 to the number of lines in sourceset cursor to busyput line N of source into whichTextput getValidFileNames(whichText,pointerField,writeField) ¬into superSetput getIntersection(subset,superSet) into intersectionif intersection is empty thenput empty into subsetexit repeatelse put intersection into subsetend repeatreturn subsetend getFileNamesfunction getCardId fileName-- Given a file name, return its card id.put cd fld "file name index" of cd "Index storage" into theIndexput getFileNameLine(fileName,theIndex) into whichLineif whichLine is empty thendialogIt "The file name" && fileName && " is not part of the" ¬&& "File Name Index. You probably need to build the File Name Index."return emptyend ifreturn item 2 of line whichLine of theIndexend getCardIdfunction itemNumber textString,theContainer-- Return the item number of the text string in the given containerif item 1 of theContainer = textString then return 1else get offset("," & textString & ",",theContainer)if it <> 0 thenget the number of items in char 1 to it of theContainerreturn it+1end ifif textString = last item of theContainer thenreturn the number of items in theContainerend ifreturn 0end itemNumberfunction binaryInsert theItem,theContainerset cursor to watch-- a few quick tests up frontif theContainer is empty then return 0-- if theItem is outside the bounds of the container then return 1if theItem > last item of theContainer OR ¬theItem < item 1 of theContainer then return 1-- if theItem exists in the container, then return its item numberif isWithinItems(theItem,t